Hardcore Visual Basic 5.0 (2nd Edition)/Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso/Code/split.cls

Text File | 1997-06-14 | 15KB | 446 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CSplitter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' Thanks to Elliott Whitticar and Vadim Katsman who fixed bugs and suggested
' improvements to my CHSplitter and CVSplitter classes. I integrated some of
' their code, but didn't solve all possible splitter problems. The primary
' improvement (implemented separately by both Elliot and Vadim) is combining
' vertical and horizontal splitters into a single class. Thanks.

' Internal variables for forms and controls
Private ctlNW As Object             ' Left/Top control
Private ctlSE As Object             ' Right/Bottom control
Private objContainer As Object

' Sizes of borders and pixels
Private xySplit As Single           ' Position of splitter bar
Private dxySplit As Single          ' Width/height of splitter bar in scale units
Private dxyMin As Single            ' Minimum control width/height
Private xPixel As Single
Private yPixel As Single
Private dxBorder As Single
Private dyBorder As Single
Private cBorderPixels As Long

' Flags
Private fResize As Boolean          ' True ==> move left and right control
Private fAutoBorder As Boolean
Private fDragging As Boolean
Private fCreated As Boolean
Private fVertical As Boolean        ' True => Vertical splitter, F => Horizontal
Private iPercent As Integer           ' 1 to 99 gives initial split Percent

' Old mouse pointer, draw style, and draw mode
Private mpOld As Integer
Private dsOld As Integer
Private dmOld As Integer

Private mpResize As Integer         ' MousePointer to use when resizing

' AutoRedraw
Private arOld As Boolean

Public Enum EErrorSplitter
    eeBaseSplitter = 13690  ' CSplitter
    eeInvalidControl        ' Invalid controls or container
    eeSplitNotCreated       ' Create splitter before using members
End Enum

#If fComponent = 0 Then
Private Sub ErrRaise(e As Long)
    Dim sText As String, sSource As String
    If e > 1000 Then
        sSource = App.EXEName & ".CSplitter"
        Select Case e
        Case eeBaseAbout
            BugAssert True
        Case eeInvalidControl
            sText = "Create: Invalid controls or container"
        Case eeSplitNotCreated
            sText = "Create splitter before using members"
        End Select
        Err.Raise COMError(e), sSource, sText
    Else
        ' Raise standard Visual Basic error
        Err.Raise e, sSource
    End If
End Sub
#End If

' Create a splitter window
Sub Create(LeftControl As Object, RightControl As Object, _
           Vertical As Boolean, _
           Optional BorderPixels As Long = 0, _
           Optional AutoBorder As Boolean = True, _
           Optional Resizeable As Boolean = True, _
           Optional Percent As Integer = 50, _
           Optional Cursor As Picture)

    fCreated = False

    On Error GoTo CreateError

    ' Set internal controls
    Set ctlNW = LeftControl
    Set ctlSE = RightControl
    Set objContainer = ctlNW.Container
    BugAssert objContainer Is ctlSE.Container

    ' Splitters work--sort of--with ClipControls True, but the splitter line
    ' isn't drawn correctly, so we disallow it in debug version (go ahead
    ' and ignore in release if you really want)
    BugAssert objContainer.ClipControls = False

    ' Save resizable and AutoBorder flags
    fAutoBorder = AutoBorder
    fResize = Resizeable
    fVertical = Vertical

    ' Handle split percent
    iPercent = Percent
    If iPercent > 99 Then iPercent = 99
    If iPercent < 1 Then iPercent = 1

    ' Set splitter size
    cBorderPixels = BorderPixels
    If cBorderPixels = 0 Then
        fAutoBorder = True
        cBorderPixels = 4
    End If

    With objContainer
        ' Size of one in pixel in current scale
        xPixel = .ScaleX(1, vbPixels, .ScaleMode)
        yPixel = .ScaleY(1, vbPixels, .ScaleMode)

        ' Set cursor
        If Cursor Is Nothing Then
            If fVertical Then
                Set .MouseIcon = LoadResPicture("VSplit", vbResCursor)
            Else
                Set .MouseIcon = LoadResPicture("HSplit", vbResCursor)
            End If
        Else
            Set .MouseIcon = Cursor
        End If
        ' Get the .MousePointer value to use when resizing
        If .MouseIcon.Type = vbPicTypeIcon Then
            mpResize = vbCustom
        ElseIf fVertical Then
            mpResize = vbSizeWE
        Else
            mpResize = vbSizeNS
        End If

        ' Set border size
        If fAutoBorder Then
            dxBorder = ctlNW.Left
            dyBorder = ctlNW.Top
        Else
            dxBorder = cBorderPixels * xPixel
            dyBorder = cBorderPixels * yPixel
        End If

        ' Set the splitter bar and minimum width/height in scale units
        ' (Ideally we'd use control properties for minimum width/height)
        If fVertical Then
            dxySplit = cBorderPixels * xPixel
            dxyMin = 20 * xPixel + 2 * dyBorder
        Else
            dxySplit = cBorderPixels * yPixel
            dxyMin = 20 * yPixel + 2 * dyBorder
        End If
        SplitPercent = Percent

    End With

    fCreated = True
    Exit Sub
CreateError:
    ErrRaise eeInvalidControl
End Sub

Property Get Capture() As Boolean
    If Not fCreated Then ErrRaise eeSplitNotCreated

    ' See if the container form or control has captured mouse events
    Capture = (GetCapture = objContainer.hWnd)
End Property


Property Let Capture(fCapture As Boolean)
    If Not fCreated Then ErrRaise eeSplitNotCreated

    ' Capture or release mouse events
    If fCapture Then
        SetCapture objContainer.hWnd
    Else
        ReleaseCapture
    End If
End Property

Private Sub Draw(ByVal xyDraw As Single, _
                 Optional xyNew As Single = -1#)
With objContainer
    ' Draw the splitter bar at the specified position

    ' The second argument is provided so MouseMove can invert the
    ' old drawing at xyDraw and draw a new splitter bar at xyNew

    .DrawStyle = vbInsideSolid
    .DrawMode = vbInvert
    If fVertical Then
        ' Erase old line
        objContainer.Line (xyDraw - xPixel, ctlNW.Top)-(xyDraw + xPixel, yBottom(ctlNW)), , B
        If Not IsMissing(xyNew) Then
            ' Draw new line
            xyDraw = xyNew
            objContainer.Line (xyDraw - xPixel, ctlNW.Top)-(xyDraw + xPixel, yBottom(ctlNW)), , B
        End If
    Else
        ' Erase old line
        objContainer.Line (ctlNW.Left, xyDraw - yPixel)-(xRight(ctlNW), xyDraw + yPixel), , B
        If Not IsMissing(xyNew) Then
            ' Draw new line
            xyDraw = xyNew
            objContainer.Line (ctlNW.Left, xyDraw - yPixel)-(xRight(ctlNW), xyDraw + yPixel), , B
        End If
    End If
End With
End Sub

Public Property Get SplitterSize() As Long
    ' Width/Height of splitter bar in scale units
    SplitterSize = dxySplit
End Property

Public Property Get SplitPercent() As Long
With objContainer
    If fVertical Then
        SplitPercent = 100 / (.ScaleWidth / (xySplit - (dxySplit / 2)))
    Else
        SplitPercent = 100 / (.ScaleHeight / (xySplit - (dxySplit / 2)))
    End If
End With
End Property

Public Property Let SplitPercent(ByVal iPercentCur As Long)
With objContainer
    Dim iMinPercent As Long
    If fVertical Then
        iMinPercent = 100 / (.ScaleWidth / (dxyMin - (dxySplit / 2)))
        If iPercentCur < iMinPercent Then iPercentCur = iMinPercent
        If iPercentCur > 100 - iMinPercent Then iPercentCur = 100 - iMinPercent
        xySplit = ((iPercent / 100) * .ScaleWidth) - (dxySplit / 2)
        ctlNW.Move dxBorder, dyBorder, _
                   xySplit - dxBorder, _
                   .ScaleHeight - (dyBorder * 2)

        ctlSE.Move xRight(ctlNW) + dxySplit, dyBorder, _
                   .ScaleWidth - ctlNW.Width - (dxBorder * 2), _
                   ctlNW.Height
    Else
        iMinPercent = 100 / (.ScaleHeight / (dxyMin - (dxySplit / 2)))
        If iPercent < iMinPercent Then iPercent = iMinPercent
        If iPercent > 100 - iMinPercent Then iPercent = 100 - iMinPercent
        dxySplit = cBorderPixels * yPixel
        dxyMin = 20 * yPixel + 2 * dyBorder
        xySplit = ((iPercent / 100) * .ScaleHeight) - (dxySplit / 2)
        ctlNW.Move dxBorder, dyBorder, _
                   .ScaleWidth - (dxBorder * 2), _
                   xySplit - dyBorder

        ctlSE.Move dxBorder, yBottom(ctlNW) + dxySplit, _
                   ctlNW.Width, _
                   .ScaleHeight - ctlNW.Height - (dyBorder * 2)
    End If
End With
End Property

Sub Resize()
With objContainer

    Dim rScaleFac As Single
    Dim dxyStart As Single, dxyFarEdge As Single
    If fVertical Then
        rScaleFac = .ScaleWidth / (dxBorder + ctlNW.Width + dxySplit + _
                                   ctlSE.Width + dxBorder)
        ' Move everything in border size from the edge
        dxyFarEdge = .ScaleHeight - dyBorder - dyBorder
        ctlNW.Move dxBorder, .ScaleTop + dyBorder, _
                   ctlNW.Width * rScaleFac, dxyFarEdge

        dxyStart = xRight(ctlNW) + dxySplit
        ctlSE.Move dxyStart, dyBorder, _
                   .ScaleWidth - dxyStart - dxBorder, dxyFarEdge
    Else    ' Resize Horizontal Splitter

        rScaleFac = .ScaleHeight / (dyBorder + ctlNW.Height + dxySplit + _
                                    ctlSE.Height + dyBorder)

        ' Move everything in border size from the edge
        dxyFarEdge = .ScaleWidth - dxBorder - dxBorder
        ctlNW.Move dxBorder, .ScaleTop + dyBorder, _
                   dxyFarEdge, ctlNW.Height * rScaleFac

        dxyStart = yBottom(ctlNW) + dxySplit
        ctlSE.Move dxBorder, dxyStart, dxyFarEdge, _
                   .ScaleHeight - dxyStart - dyBorder
    End If
End With
End Sub

Sub Splitter_MouseMove(Button As Integer, Shift As Integer, _
                       X As Single, Y As Single)
With objContainer
    If Not fCreated Then ErrRaise eeSplitNotCreated
    Dim xyNew As Single, xyMinPos As Single, xyMaxPos As Single
    Dim fZone As Boolean    ' Over Splitter Bar flag

    ' Change the cursor to splitter or back
    ' Are we in the container's client area?
    If X >= 0 And X <= .ScaleWidth Then
        If Y >= .ScaleTop And _
            Y <= .ScaleTop + .ScaleHeight Then
            ' Are we in the splitter bar zone?
            If fVertical Then
                If X < ctlSE.Left And X > xRight(ctlNW) Then fZone = True
            Else
                If Y < ctlSE.Top And Y > yBottom(ctlNW) Then fZone = True
            End If
        End If
    End If

    If fZone Then   ' We're over the splitter bar
        If .MousePointer <> mpResize Then
            mpOld = .MousePointer
            .MousePointer = mpResize
            Me.Capture = True
        End If
    ElseIf (.MousePointer = mpResize) And Not fDragging Then
        .MousePointer = mpOld
        Me.Capture = False
    End If

    ' Move the splitter line if within range
    If fDragging Then
        If fVertical Then
            xyNew = X
            xyMinPos = dxyMin
            xyMaxPos = .ScaleWidth - dxyMin
        Else    ' We're moving the horizontal line
            xyNew = Y
            xyMinPos = .ScaleTop + dxyMin
            xyMaxPos = .ScaleTop + .ScaleHeight - dxyMin
        End If
        If (xySplit <> xyNew) And _
            (xyNew > xyMinPos) And (xyNew < xyMaxPos) Then
            ' Erase the old line at xySplit and draw the new line
            Draw xySplit, xyNew
            xySplit = xyNew
        End If
    End If
End With
End Sub

Sub Splitter_MouseDown(Button As Integer, Shift As Integer, _
                       X As Single, Y As Single)
With objContainer
    If Not fCreated Then ErrRaise eeSplitNotCreated
    Dim fZone As Boolean

    If fVertical Then
        fZone = X > xRight(ctlNW) And X < ctlSE.Left
    Else
        fZone = Y > yBottom(ctlNW) And Y < ctlSE.Top
    End If

    ' If over splitter start a drag
    If fZone Then
        If Button = vbLeftButton Then
            ' Save and restore state
            fDragging = True
            dsOld = .DrawStyle
            dmOld = .DrawMode
            arOld = .AutoRedraw
            .AutoRedraw = False
            ' Determine splitter line position
            If fVertical Then
                xySplit = xRight(ctlNW) + (dxBorder / 3)
            Else
                xySplit = yBottom(ctlNW) + (dyBorder / 3)
            End If
            ' Draw the splitter line
            Draw xySplit
        End If
    Else
        If .MousePointer = mpResize Then .MousePointer = mpOld
    End If
End With
End Sub

Sub Splitter_MouseUp(Button As Integer, Shift As Integer, _
                     X As Single, Y As Single)
With objContainer
    If Not fCreated Then ErrRaise eeSplitNotCreated

    If fDragging Then
        ' Erase old line
        Draw xySplit
        fDragging = False

        ' Resize the panes if in range
        If fVertical Then
            If X > dxyMin And X < (.ScaleWidth - dxyMin) Then
                ctlNW.Width = X - ctlNW.Left - (dxySplit / 2)
                ctlSE.Left = xRight(ctlNW) + dxySplit
                ctlSE.Width = .ScaleWidth - ctlSE.Left - dxBorder
            End If
        Else
            If Y > .ScaleTop + dxyMin And Y < (.ScaleTop + .ScaleHeight - dxyMin) Then
                ctlNW.Height = Y - ctlNW.Top - (dxySplit / 2)
                ctlSE.Top = yBottom(ctlNW) + dxySplit
                ctlSE.Height = .ScaleTop + .ScaleHeight - ctlSE.Top - dyBorder
            End If
        End If
        .DrawStyle = dsOld
        .DrawMode = dmOld
        .AutoRedraw = arOld
    End If

    ' Restore the pointer
    If .MousePointer = mpResize Then
         .MousePointer = mpOld
         Me.Capture = False
    End If
End With
End Sub

Sub Splitter_Resize()
    If objContainer Is Nothing Then Exit Sub
    If Not fCreated Then ErrRaise eeSplitNotCreated
    On Error Resume Next
    ' Only forms have WindowState
    If objContainer.WindowState <> vbMinimized And fResize Then Resize
    ' Must not be form
    If Err And fResize Then Resize
End Sub

Private Function xRight(obj As Object) As Single
    xRight = obj.Left + obj.Width
End Function

Private Function yBottom(obj As Object) As Single
    yBottom = obj.Top + obj.Height
End Function